home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
smaltalk
/
manchest.lha
/
MANCHESTER
/
manchester
/
4.1
/
PanningWrapper.st
< prev
next >
Wrap
Text File
|
1993-07-24
|
4KB
|
171 lines
" NAME panning-wrapper
AUTHOR bhoran@cs.man.ac.uk (Bernard Horan) and miw@cs.man.ac.uk (Mario Wolczko)
FUNCTION a wrapper for panning over large two-way scrollable area
ST-VERSION 4.1
PREREQUISITES
CONFLICTS
DISTRIBUTION world
VERSION 2.1
DATE 10 Nov 1992
SUMMARY This goodie provides a wrapper class and controller that can be
used in a view to pan over a larger view.
Cursor>fourWay is the cursor displayed when panning.
Mario Wolczko
Dept. of Computer Science Internet: mario@cs.man.ac.uk
The University uucp: uknet!!man.cs!!mario
Manchester M13 9PL JANET: mario@uk.ac.man.cs
U.K. Tel: +44-61-275 6146 (FAX: 6236)
______the mushroom project___________________________________
"
'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 10 November 1992 at 12:36:37 am'!
Controller subclass: #PanningController
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Interface-Support'!
PanningController comment:
'PanningController is used by a PanningWrapper, so it can be panned/scrolled in any direction using the <select> button.
Modified from Mario Wolczko''s earlier R4.0 version for R4.1.
Bernard Horan, 16 October 1992'!
!PanningController methodsFor: 'control defaults'!
controlActivity
| last pt oldGrid |
last := self sensor cursorPoint.
oldGrid := view scrollGrid.
view scrollGrid: 1@1.
Cursor fourWay showWhile:
[[self sensor redButtonPressed] whileTrue:
[self poll.
pt := self sensor cursorPoint.
pt ~= last
ifTrue: [view scrollBy: last - pt. last := pt]]].
view scrollGrid: oldGrid.!
isControlActive
^self sensor redButtonPressed "and: [self viewHasCursor]"! !
'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 10 November 1992 at 12:36:40 am'!
ScrollWrapper subclass: #PanningWrapper
instanceVariableNames: 'controller '
classVariableNames: ''
poolDictionaries: ''
category: 'Interface-Support'!
PanningWrapper comment:
'A PanningWrapper is like a ScrollWrapper, but also allows panning, when that component does not want control.
My controller is usually a PanningController.
Adapted from Mario Wolczko''s earlier R4.0 version.
Bernard Horan, 16 October 1992'!
!PanningWrapper methodsFor: 'initialize-release'!
initialize
super initialize.
controller := PanningController new.
controller view: self! !
!PanningWrapper methodsFor: 'control defaults'!
myControllerWantingControl
^controller isControlWanted ifTrue: [controller] ifFalse: [nil]!
objectWantingControl
"Check if a subview wants control; if not, check my controller."
| c |
c := super objectWantingControl.
c isNil ifTrue: [c := self myControllerWantingControl].
^c! !
!PanningWrapper methodsFor: 'accessing'!
controller: c
controller := c!
getController
^controller! !
!PanningWrapper methodsFor: 'scrolling'!
scrollBy: aPoint
self scrollHorizontallyBy: aPoint x.
self scrollVerticallyBy: aPoint y.!
scrollGrid
^origin grid!
scrollGrid: aPoint
^origin grid: aPoint! !
!PanningWrapper methodsFor: 'private'!
setComponent: aVisualComponent
"Set the receiver's component to be aVisualComponent. If the receiver is open, propagate damage.
This is so wrappers can have dynamically changing components."
super setComponent: aVisualComponent.
origin grid: 4@4! !
Cursor addClassVarName: 'FourWay'!
!Cursor class methodsFor: 'private-constant initialization'!
initFourWay
"Cursor initFourWay"
FourWay :=
(self
imageArray: #(
2r0000000100000000
2r0000001110000000
2r0000011111000000
2r0000111111100000
2r0001001110010000
2r0011001110011000
2r0111111111111100
2r1111111111111110
2r0111111111111100
2r0011001110011000
2r0001001110010000
2r0000111111100000
2r0000011111000000
2r0000001110000000
2r0000000100000000
2r0000000000000000)
maskArray: #(
2r0000000100000000
2r0000001110000000
2r0000011111000000
2r0000111111100000
2r0001001110010000
2r0011001110011000
2r0111111111111100
2r1111111111111110
2r0111111111111100
2r0011001110011000
2r0001001110010000
2r0000111111100000
2r0000011111000000
2r0000001110000000
2r0000000100000000
2r0000000000000000)
hotSpot: 8@8 name: 'four way')! !
!Cursor class methodsFor: 'constants'!
fourWay
^FourWay! !
Cursor initFourWay!